Enter 2005 August/EnterCD 08_2005.iso/dosapps/pci/PCI.PAS

Pascal/Delphi Source File | 2005-03-16 | 66.3 KB | 2,451 lines

Program PCI;

{$G+}
{$R-}
{$S-}
{$I+}
{$N+}
{$E+}
{$Q-}



uses newdelay,dos,crt;


{$I classes.pas}


{
  This code is Written by Craig Hart in 1996-2005. It is released as freeware;
  please use and modify at will. No guarantees are made or implied.


  Please read the accompaning documentation PCI.DOC for all the info
  relating to this program!
}



const
  revision    : string[5]='1.1';

type treedata =
  record
    b,
    d,
    f    : byte;
    vid,
    did    : word;
  end;

var
  olb,
  lastd,
  lastb,
  agpbusnum,
  lw,
  wrlncount,
  PCIverhi,
  PCIverlo,
  PCIchar,
  PCI_hibus,
  errcode,
  deviceid,
  func,
  info,
  lb,
  bus,
  sum,
  disp,
  cap_ptr,
  max        : byte;

  showtree,
  pdatareg,
  found,
  businfo,
  userev,
  tableok,
  dorouting,
  dopcirouting,
  summary,
  bogusid,
  genssid,
  dumpregs,
  usebios,
  failed,
  first,
  installermode    : boolean;


  irqmap    : array[0..15] of byte;

  pdata        : array[0..15] of byte;
  pscale    : array[0..15] of byte;
  presult    : array[0..15] of byte;


  tree        : array[0..199] of treedata;

  pmcsr,
  romsize,
  romresult,
  rom_backup    : longint;

  spl        : real;

  count,
  mb,
  ml,
  conmap,
  len,
  addr,
  index,
  i,
  j,
  l,
  v        : word;

  f        : text;

  revchk,
  oemidnum,
  oemidstr,
  cmdstr,
  vstr,
  cmpstr    : string;


  infotbl    : array[0..$ff] of byte;

  irqbuff    : array[0..1023] of byte;

  linecounter   : word;
  org_output    : pointer;


  cardbus    : array[1..16] of byte;
  cbu,
  cardptr    : byte;


















procedure pagefilter1(var t:text);assembler;
asm
  push ax
  push di
  push es
  push cx

  les di,[t]
  mov cx,es:[di+TextRec.BufPos]
  les di,es:[di+TextRec.BufPtr]
  cld
  mov al,10

@sl:
  jcxz @ret
  dec cx
  scasb
  jne @sl
  inc linecounter
  jmp @sl

@ret:
  pop cx
  pop es
  pop di
  pop ax
end;

procedure pagefilter2;assembler;
asm
  push ax
  mov ax,WindMax
  shr ax,8
  cmp linecounter,ax
  jb @ret

  sub ax,ax
  int $16

  mov linecounter,0

@ret:
  pop ax
end;

procedure page_output_FlushFunc;assembler;
asm
  push es
  push bx
  call pagefilter1
  push es
  push bx
  call [org_output]
  call pagefilter2
  retf 4
end;











function cvtb(b:byte) : byte;
begin
  if b>9 then cvtb:=b+ord('A')-10 else cvtb:=b+ord('0');
end;

function wrhexb(byt:byte): string;
begin
 wrhexb:=chr(cvtb(byt and $0f));
end;

function wrhex(byt:byte) : string;
begin
  wrhex:=chr(cvtb((byt and $f0) shr 4))+chr(cvtb(byt and $0f));
end;

function wrhexw(wor:word): string;
begin
  wrhexw:=chr(cvtb(wor shr 12))+chr(cvtb((wor shr 8) and $f))+chr(cvtb((wor shr 4) and $f))+chr(cvtb(wor and $f));
end;


(* Make the PCI configuration status register printout pretty *)
(* Input = the string to be output *)

Procedure printstatus (s : string);
Begin
  if not first then if (length(s)+wherex)>78 then
  begin
    writeln(',');
    write('   ');
  end else write(', ');
  write(s);
  first:=false;
End;


function IORedirected : boolean ; Assembler;
asm
  push ds
  mov ax,prefixseg
  mov ds,ax
  xor bx,bx
  les bx,[bx + $34]
  mov al,es:[bx]
  mov ah,es:[bx +1]
  pop ds
  cmp al,ah
  mov al,true
  jne @exit

  mov al,false

 @exit:
end;

function lookup_bios(deviceid,func,bus:byte;index:word) : byte;

var inf:byte;

begin
  asm
    mov ax,$b108
    mov bl,deviceid
    shl bl,3
    add bl,func
    mov bh,bus
    mov di,index
    int $1a
    jc @exit

    mov failed,false
    mov inf,cl
  @exit:
    mov errcode,ah
  end;
  lookup_bios:=inf;
end;


function lookup_hw(deviceid,func,bus:byte;index:word) : byte;
var inf:byte;

begin
  asm
    mov ax,$8000
    mov al,bus
    db $66;shl ax,16

    mov ax,index
    and ax,00fch
    mov ah,deviceid
    shl ah,3
    add ah,func

    mov dx,0cf8h
    db $66;out dx,ax

    mov ax,index
    and ax,3
    mov bl,8
    mul bl
    mov cx,ax

    mov dx,0cfch
    db $66;in ax,dx
    db $66;shr ax,cl
    mov inf,al
    mov failed,false


    db $66;xor ax,ax
    mov dx,0cf8h
    db $66;out dx,ax

  end;
  lookup_hw:=inf;
end;


procedure write_dword_bios(deviceid,func,bus:byte;index,datah,datal:word);
begin
  asm
    mov ax,$b10d
    mov bl,deviceid
    shl bl,3
    add bl,func
    mov bh,bus
    mov di,index
    mov cx,datah
    db $66; rol cx,16
    mov cx,datal
    int $1a
    mov errcode,ah
  end;
end;

procedure write_dword_hw(deviceid,func,bus:byte;index,datah,datal:word);
begin
  asm
    mov ax,$8000
    mov al,bus
    db $66;shl ax,16

    mov ax,index
    and ax,00fch
    mov ah,deviceid
    shl ah,3
    add ah,func

    mov dx,0cf8h
    db $66;out dx,ax

    mov ax,index
    and ax,3
    mov bl,8
    mul bl
    mov cx,ax

    mov ax,datah
    db $66;shl ax,16
    mov ax,datal

    mov dx,0cfch
    db $66;out dx,ax
    mov failed,false

    db $66;xor ax,ax
    mov dx,0cf8h
    db $66;out dx,ax
  end;
end;

procedure listmap(va:word;dispst:string);
var
  comma     : byte;
  failed : boolean;
  l,
  j     : word;

begin
  failed:=true;
  write(dispst);
  comma:=0;
  for l:=0 to 15 do if (va and (1 shl l))>0 then inc(comma);

  l:=1;
  j:=0;
  repeat
    if (va and l)=l then
    begin
      write(j);
      if comma>1 then write(',') else write(' ');
      dec(comma);
      failed:=false;
    end;
    l:=l shl 1;
    inc(j);
  until j=16;
  if failed then writeln('None') else writeln;
end;


procedure lookupven(silent:boolean);
begin
  reset(f);
  failed:=true;
  repeat
    readln(f,vstr);
    if length(vstr)<3 then vstr:=';   oops';
    if (vstr[1]='V') and (copy(vstr,3,4)=cmpstr) then
    begin
      textcolor(14);
      if not silent then write(copy(vstr,8,length(vstr)));
      textcolor(7);
      failed:=false;
    end;
  until eof(f) or not failed;
  if failed and not silent then
  begin
    textcolor(12);
    write('Unknown');
    textcolor(7);
  end;
end;

procedure lookupdev;
begin
revchk:='';
  failed:=true;
  if not eof(f) then
  repeat
    readln(f,vstr);
    if length(vstr)<3 then vstr:=';   oops';
    if (vstr[1]='D') and (copy(vstr,3,4)=cmpstr) then
    begin
     if not eof(f) then readln(f,revchk);
     if revchk[1]='R' then
     repeat
       if wrhex(infotbl[8])=copy(revchk,3,2) then
         vstr:='xxxxxxx'+copy(revchk,6,length(revchk));
       if not eof(f) then readln(f,revchk);
     until revchk[1]<>'R';
     textcolor(14);
     write(copy(vstr,8,length(vstr)));
     failed:=false;
     textcolor(7);
    end;
  until eof(f) or not failed or (vstr[1]='V');
  if failed then
  begin
    textcolor(12);
    write('Unknown');
    textcolor(7);
  end;
end;


procedure showinstallerinfo;
begin
  write('V:',wrhexw(infotbl[1] shl 8+infotbl[0]),' ');

  write('D:',wrhexw(infotbl[3] shl 8+infotbl[2]),' ');

  write('S:');
  if infotbl[$e] and $7f=0 then
  begin
    write(wrhexw(infotbl[$2f] shl 8+infotbl[$2e]));
    write(wrhexw(infotbl[$2d] shl 8+infotbl[$2c]),' ');
  end else write('00000000 ');

  write('B:',bus,' ');

  write('E:');
  if deviceid<10 then write('0');
  write(deviceid,' ');

  write('F:',func,' ');

  write('I:');
  if (infotbl[$3c]<16) and (infotbl[$3c]>0) then
  begin
    if infotbl[$3c]<10 then write('0');
    write(infotbl[$3c],' ');
  end else write('00 ');

  write('N:');
  if (infotbl[$3c]<16) and (infotbl[$3c]>0) then
  begin
    if infotbl[$3d]=0 then write('- ') else write(chr(infotbl[$3d]+64),' ');
  end else write('- ');

  write('C:');
  write(wrhex(infotbl[$b]),' ');

  write('U:');
  write(wrhex(infotbl[$a]),' ');

  write('P:');
  write(wrhex(infotbl[$9]),' ');

  write('R:');
  write(wrhex(infotbl[$8]),' ');

  writeln;
end;


procedure showroutinginfo;
begin
  writeln('ROM PCI IRQ routing table Windows 9x Compatibility Tests....');


{ Find table }
  i:=0;
  failed:=true;
  repeat
   if (memw[$f000:i]=$5024) and (memw[$f000:i+2]=$5249) then failed:=false;
   if failed then i:=i+16;
  until (i>$ffef) or not failed;


{ check table }
  if not failed then
  begin
    tableok:=true;

    writeln(' ROM IRQ routing table found at F000h:',wrhexw(i),'h');
    write(' Table Version ',mem[$f000:i+5],'.',mem[$f000:i+4]);
    if (mem[$f000:i+5]=1) and (mem[$f000:i+4]=0) then writeln(' - OK') else
    begin
      textcolor(12);
      writeln('Invalid Version!');
      textcolor(7);
      tableok:=false;
    end;

    write(' Table size ',memw[$f000:i+6],' bytes - ');
    if (memw[$f000:i+6]<33) or (memw[$f000:i+6] mod 16<>0) then
    begin
      textcolor(12);
      writeln('Invalid Size!');
      textcolor(7);
      tableok:=false;
    end else writeln('OK');



    if tableok then
    begin
      write(' Table Checksum ',wrhex(mem[$f000:i+31]),'h - ');
      {$R-}  {Range checking off as sum is DELIBERATELY meant to overfow }
      sum:=0;
      for l:=0 to memw[$f000:i+6]-1 do
      begin
    sum:=sum+mem[$f000:i+l];
      end;
      {$R+}
      if sum=0 then writeln('OK') else
      begin
    textcolor(12);
    writeln('Failed!');
    textcolor(7);
    tableok:=false;
      end;
    end;


    listmap(memw[$f000:i+10],' IRQ''s dedicated to PCI : ');

    if tableok then
    begin
      textcolor(10);
      writeln(' The ROM PCI IRQ routing table appears to be OK.');
      textcolor(7);
    end else
    begin
      textcolor(12);
      writeln(' The ROM PCI IRQ routing table appears to be faulty!!');
      textcolor(7);
    end;

  end else
  begin
    textcolor(12);
    writeln('No ROM PCI IRQ routing table found!!!');
    textcolor(7);
  end;
end;


procedure dohexdump;
begin
  writeln('Hex-Dump of IRQ Routing table : ');
  writeln;
  write('  0000  ');
  for i:=0 to 1023 do
  begin
    if (i>0) and (i mod 16=0) then
    begin
      write('   ');
      for j:=i-16 to i-1 do if ord(irqbuff[j])<32 then write('.') else write(chr(irqbuff[j]));
      writeln;
      write('  ',wrhexw(i),'  ');
    end;
    write(wrhex(irqbuff[i]),' ');
  end;
  write('   ');
  for j:=1008 to 1023 do if ord(irqbuff[j])<32 then write('.') else write(chr(irqbuff[j]));
  writeln;
  writeln;
end;


procedure docapdecode;
var i : word;
begin
  writeln(' New Capabilities List Present:');
{type 0}     if infotbl[$e] and $7f=0 then cap_ptr:=infotbl[$34];
{type 1}     if infotbl[$e] and $7f=1 then cap_ptr:=infotbl[$34];
{type 2}     if infotbl[$e] and $7f=2 then cap_ptr:=infotbl[$14];

  if cap_ptr<>0 then
  repeat
    case infotbl[cap_ptr] of

      01 : begin
         write('   Power Management Capability, Version ');
         if infotbl[cap_ptr+2]and 7=3 then writeln('1.2') else
         if infotbl[cap_ptr+2]and 7=2 then writeln('1.1') else
         if infotbl[cap_ptr+2]and 7=1 then writeln('1.0') else
         begin
           textcolor(12);
           writeln('Unknown: Code ',wrhexb(infotbl[cap_ptr+2]and 7),'h');
           textcolor(7);
         end;


{ list supported low-power states; D3 and D0 are always supported}
         if infotbl[cap_ptr+3] and 2=2 then writeln('     Supports low power State D1');
         if infotbl[cap_ptr+3] and 4=4 then writeln('     Supports low power State D2');
         if infotbl[cap_ptr+3] and 6=0 then writeln('     Does not support low power State D1 or D2');

{list PME# generation capabilities}
         if (infotbl[cap_ptr+3] shr 3) = 0 then writeln('     Does not support PME# signalling') else
         begin
           write('     Supports PME# signalling from mode(s) ');
           first:=true;
           if (infotbl[cap_ptr+3] shr 3) and 1=1 then printstatus('D0');
           if (infotbl[cap_ptr+3] shr 3) and 2=2 then printstatus('D1');
           if (infotbl[cap_ptr+3] shr 3) and 4=4 then printstatus('D2');
           if (infotbl[cap_ptr+3] shr 3) and 8=8 then printstatus('D3hot');
           if (infotbl[cap_ptr+3] shr 3) and 16=16 then printstatus('D3cold');
           writeln;

           write('     PME# signalling is currently ');
           if infotbl[cap_ptr+5] and 1=1 then writeln('enabled') else writeln('disabled');
          end;


         write('     Current Power State : D');
         case infotbl[cap_ptr+4] and 3 of
           0 : writeln('0 (Device operational, no power saving)');
           1 : writeln('1 (Device idle, minimum power saving)');
           2 : writeln('2 (Device CLK stopped, medium power saving)');
           3 : writeln('3hot (Device off: no power to device, maximum power saving)');
         end;


{ try to read the power levels, but only if card not asleep now. }
         if infotbl[cap_ptr+4] and 3=0 then
         begin
{ backup registers we are going to mess with }
         pmcsr:=infotbl[cap_ptr+7] shl 24 + infotbl[cap_ptr+6] shl 16 + infotbl[cap_ptr+5] shl 8 + infotbl[cap_ptr+4];

         for i:=0 to 15 do
         begin
           write_dword_hw(deviceid,func,bus,cap_ptr+4,0000,(((infotbl[$e1] shl 8) + infotbl[$e0]) and $0103) + (i shl 9));
           presult[i]:=(lookup_hw(deviceid,func,bus,cap_ptr+5) shr 1) and $f;
           pdata[i]:=lookup_hw(deviceid,func,bus,cap_ptr+7);
           pscale[i]:=(lookup_hw(deviceid,func,bus,cap_ptr+5) shr 5) and 3;
         end;

{ restore original values to registers regardless }
         write_dword_hw(deviceid,func,bus,cap_ptr+4,pmcsr shr 16,pmcsr and $ffff);

{ is the reg valid ? }
         pdatareg:=false;
         for i:=0 to 15 do if (pdata[i]<>0) or (pscale[i]<>0) then pdatareg:=true;

         if pdatareg then
         begin
           writeln('     Power Data Registers Information:');

{ debug: for i:=0 to 15 do writeln('Index: ',i,', Data: ',pdata[i],', Scale: ',pscale[i]);}



           if infotbl[$e] and $80=0 then max:=7 else max:=8;
           for i:=0 to max do
           begin
             case i of
               0..3 : write('      D',i,' Power Consumed: ');
               4..7 : write('      D',i-4,' Power Dissipated: ');
               8 :  write('      Common logic Power Consumed: ');
             end;
             case pscale[i] of
               0 : write('???');
               1 : write(pdata[i]*100);
               2 : write(pdata[i]*10);
               3 : write(pdata[i]);
             end;
             writeln('mW');
           end;
         end else
         begin
           if (infotbl[cap_ptr+3] shr 3) and 16=16 then
           begin
             write('     3.3v AUX Current required : ');
             case ((infotbl[cap_ptr+3] and 1) shl 2) + (infotbl[cap_ptr+2] shr 6) of
               0 : writeln('0mA (Self powered)');
               1 : writeln('55mA');
               2 : writeln('100mA');
               3 : writeln('160mA');
               4 : writeln('220mA');
               5 : writeln('270mA');
               6 : writeln('320mA');
               7 : writeln('375mA');
             end;
           end;
         end;
         end;
       end;


      02 : begin
         write('   AGP Capability, Version ');
         write(infotbl[cap_ptr+2] shr 4,'.',infotbl[cap_ptr+2] and $0f,' ');
         if (infotbl[cap_ptr+2] shr 4)=1 then writeln('(AGP 1x and/or 2x support)');
         if (infotbl[cap_ptr+2] shr 4)=2 then writeln('(AGP 4x and below support)');
         if (infotbl[cap_ptr+2] shr 4)=3 then
         begin
           write('(AGP 8x and 4x');
           if (infotbl[cap_ptr+2] and $0f)<5 then write(', core register');
           if ((infotbl[cap_ptr+2] and $0f)>4) and
         ((infotbl[cap_ptr+2] and $0f)<10) then write(', appendix register');
           writeln(' support)');
         end;



{ Status register }

         write('     AGP Speed(s) Supported : ');
         if infotbl[cap_ptr+4] and 8=8 then
         begin
           if infotbl[cap_ptr+4] and 1=1 then write('4x ');
           if infotbl[cap_ptr+4] and 2=2 then write('8x ');
           if infotbl[cap_ptr+4] and 7>3 then write('Unknown Speed Reported (',wrhex(infotbl[cap_ptr+4] and 7),'h)!!');
         end else
         begin
           if infotbl[cap_ptr+4] and 1=1 then write('1x ');
           if infotbl[cap_ptr+4] and 2=2 then write('2x ');
           if infotbl[cap_ptr+4] and 4=4 then write('4x ');
           if infotbl[cap_ptr+4] and 7=0 then
           begin
                 textcolor(12);
         write('None!!');
                 textcolor(11);
         write(' (Assume Only 1x Support)');
                 textcolor(7);
           end;
         end;
         writeln;

         write('     FW Transfers Supported : ');
         if infotbl[cap_ptr+4] and $10=$10 then writeln('Yes') else writeln('No');

         write('     >4Gb Address Space Supported : ');
         if infotbl[cap_ptr+4] and $20=$20 then writeln('Yes') else writeln('No');

         write('     Sideband Addressing Supported : ');
         if infotbl[cap_ptr+5] and 2=2 then writeln('Yes') else writeln('No');

{ if v3.? reported, see if v3.0 mode is on }
         if (infotbl[cap_ptr+2] shr 4)=3 then
         begin
           write('     AGP v3.0 Operation Mode Available : ');
           if infotbl[cap_ptr+4] and 8=8 then writeln('Yes') else writeln('No');
         end;

{ isosynch only in AGP v3.0 mode }
         if infotbl[cap_ptr+4] and 8=8 then
         begin
           write('     Isosynchronous Transactions Supported : ');
           if infotbl[cap_ptr+6] and 2=2 then writeln('Yes') else writeln('No');
         end;


         write('     Maximum Command Queue Length : ',infotbl[cap_ptr+7]+1,' byte');
         if infotbl[cap_ptr+7]=0 then writeln else writeln('s');

{ Command register }

         write('     AGP Speed Selected : ');
         if infotbl[cap_ptr+4] and 8=8 then
         begin
           if infotbl[cap_ptr+8] and 7=1 then write('4x ');
           if infotbl[cap_ptr+8] and 7=2 then write('8x ');
           if infotbl[cap_ptr+8] and 7>2 then write('Unknown Speed Reported (',wrhex(infotbl[cap_ptr+8] and 7),'h)!!');
           if infotbl[cap_ptr+8] and 7=0 then write('None Selected');
         end else
         begin
           if infotbl[cap_ptr+8] and 7=1 then write('1x ');
           if infotbl[cap_ptr+8] and 7=2 then write('2x ');
           if infotbl[cap_ptr+8] and 7=4 then write('4x ');
           if infotbl[cap_ptr+8] and 7=0 then write('None Selected');
         end;
         writeln;

         write('     FW Transfers Enabled : ');
         if infotbl[cap_ptr+8] and $10=$10 then writeln('Yes') else writeln('No');

         write('     >4Gb Address Space Enabled : ');
         if infotbl[cap_ptr+8] and $20=$20 then writeln('Yes') else writeln('No');

         write('     AGP Enabled : ');
         if infotbl[cap_ptr+9] and 1=1 then
         begin
               textcolor(10);
           writeln('Yes');
               textcolor(7);
          end else
          begin
                textcolor(12);
                writeln('No');
                textcolor(7);
          end;

         write('     Sideband Addressing Enabled : ');
         if infotbl[cap_ptr+9] and 2=2 then writeln('Yes') else writeln('No');

         if infotbl[cap_ptr+4] and 8=8 then
         begin
           write('     AGP v3.0 Operation Mode : ');
           if infotbl[cap_ptr+9] and 1=1 then writeln('Enabled') else writeln('Disabled');
         end;

         write('     Current Command Queue Length : ',infotbl[cap_ptr+11]+1,' byte');
         if infotbl[cap_ptr+11]=0 then writeln else writeln('s');
       end;


      03 : begin
         writeln('   Vital Product Data Capability');
       end;


      04 : begin
         writeln('   Slot Identification Capability');

         write('     This is ');
         if infotbl[cap_ptr+2] and $20=0 then write('not ');
         writeln('a parent bridge');

         write('     Number of slots on secondary side of this bridge : ');
         writeln(infotbl[cap_ptr+2] and $1f);

         writeln('Chassis Number : ',infotbl[cap_ptr+3]);
       end;


      05 : begin
         writeln('   Message Signalled Interrupt Capability');
         write('     MSI is ');
         if infotbl[cap_ptr+2] and 1=1 then writeln('enabled') else writeln('disabled');

         write('     MSI function can generate ');
         if infotbl[cap_ptr+2] and 128=128 then write('64') else write('32');
         writeln('-bit addresses');
        end;


      06 : begin
         writeln('   CompactPCI Hot-Swap Capability');
       end;


      07 : begin
         writeln('   PCI-X Capability');

{ type 1 }
         if infotbl[$e] and $7f=1 then
         begin
           write('     Secondary AD Bus size is ');
           if infotbl[cap_ptr+2] and 1=1 then write('64') else write('32');
           writeln('-bit');

           write('     Secondary AD Bus Maximum Speed in PCI-X mode is ');
           if infotbl[cap_ptr+2] and 2=2 then write('133') else write('66');
           writeln('MHz');

           write('     Seconday AD Bus Current Speed : ');
           case ((infotbl[cap_ptr+3] and 1) shl 8 + (infotbl[cap_ptr+2] and $c0) shr 6) of
         0 : write('33');
         1 : write('66');
         2 : write('100');
         3 : write('133');
         4..7 : write('Unknown!');
           end;

         end;

{ type 0 and 1 }
         write('     Primary AD Bus size is ');
         if infotbl[cap_ptr+6] and 1=1 then write('64') else write('32');
         writeln('-bit');

         write('     Primary AD Bus Maximum Speed in PCI-X mode is ');
         if infotbl[cap_ptr+6] and 2=2 then write('133') else write('66');
         writeln('MHz');
       end;

      08 : begin
             writeln('   HyperTransport Capability');
             write('     SubType : ');
             if infotbl[cap_ptr+3] and $e0=0 then writeln('Slave/Primary Interface') else
             if infotbl[cap_ptr+3] and $e0=$20 then writeln('Host/Secondary Interface') else
             case infotbl[cap_ptr+3] and $F8 of
               $40 : writeln('Switch');
               $80 : writeln('Interrupt Discovery & Configuration');
               $88 : writeln('Revision ID');
               $90 : writeln('UnitID Clumping');
               $98 : writeln('Extended Configuration Space Access');
               $A0 : writeln('Address Mapping');
               $A8 : writeln('MSI Mapping');
               $B0 : writeln('DirectRoute');
               $B8 : writeln('VCSet');
               $C0 : writeln('Retry mode');
               $C8 : writeln('x86 Encoding(Reserved)');
               else writeln('?? Unknown');
             end;

{ Slave/Pri : type 000xx}
             if infotbl[cap_ptr+3] and $e0=0 then
             begin
               writeln('     Base UnitID  : ',infotbl[cap_ptr+2] and $1f);
               writeln('     UnitID Count : ',((infotbl[cap_ptr+3] and 3) shl 3) + (infotbl[cap_ptr+2] shr 5));
             end;

           end;


      09 : begin
         writeln('   Vendor-Dependant Capability');
       end;

     $0a : begin
         writeln('   USB 2.0 EHCI Debug Port Capability');
       end;

     $0b : begin
         writeln('   CompactPCI Resource Control Capability');
       end;

     $0c : begin
         writeln('   PCI Hot-Plug Capability');
       end;

     $0d : begin
             writeln('   Subsystem ID & Subsystem Vendor ID Capability');
             writeln('     SSVID : ',wrhexw(infotbl[cap_ptr + 5] shl 8 + infotbl[cap_ptr + 4]),'h');
             writeln('     SSID  : ',wrhexw(infotbl[cap_ptr + 7] shl 8 + infotbl[cap_ptr + 6]),'h');
           end;

     $0e : begin
         writeln('   AGP 8x Capability');
       end;

     $0f : begin
         writeln('   Secure Device Capability');
       end;

     $10 : begin
         writeln('   PCI Express Capability, Version ',infotbl[cap_ptr+2] and $f);


{ **** 3GIO Capabilities field 2-3}
         write('     Device/Port Type : ');
         case infotbl[cap_ptr+2] shr 4 of
           0 : writeln('PCI Express Endpoint Device');
           1 : writeln('Legacy PCI Express Endpoint Device');
           4 : writeln('Root port of PCI Express Root Complex');
           5 : writeln('Upstream port of PCI Express Switch');
           6 : writeln('Downstream port of PCI Express Switch');
           7 : writeln('PCI Express to PCI/PCI-X Bridge');
           9 : writeln('Root Complex Integrated Endpoint Device');
           else writeln('Unknown (',wrhex(infotbl[cap_ptr+2] shr 4),'h)!!');
          end;

{ ports only }
          if (infotbl[cap_ptr+2] shr 4=4) or (infotbl[cap_ptr+2] shr 4=6) then
          begin
            write('     Port is an ');
            if infotbl[cap_ptr+3] and 1=1 then writeln('Expansion Slot') else writeln('Integrated Device');
          end;

{ **** Device Capabilities field 4-7}
{ devices only }
          if (infotbl[cap_ptr+2] shr 4=0) or (infotbl[cap_ptr+2] shr 4=1) then
          begin
              if infotbl[cap_ptr+5] and 16=16 then writeln('     Attention Button Present on Device');
            if infotbl[cap_ptr+5] and 32=32 then writeln('     Attention Indicator Present on Device');
            if infotbl[cap_ptr+5] and 64=64 then writeln('     Power Indicator Present on Device');
          end;

{ upstream ports only }
          if infotbl[cap_ptr+2] shr 4=5 then
          begin
              write('     Slot Power Limit Value : ');
        spl:=(infotbl[cap_ptr+6] shr 2) + ((infotbl[cap_ptr+7] and 3) shl 6);
              if ((infotbl[cap_ptr+7] and $c) shr 2)=0 then spl:=spl;
              if ((infotbl[cap_ptr+7] and $c) shr 2)=1 then spl:=spl*0.1;
              if ((infotbl[cap_ptr+7] and $c) shr 2)=2 then spl:=spl*0.01;
              if ((infotbl[cap_ptr+7] and $c) shr 2)=3 then spl:=spl*0.001;
              writeln(spl,' Watts');
            end;

{ **** Device Control Field 8-9}
            if infotbl[cap_ptr+8] and 1=1 then writeln('     Correctable Error Reporting Enabled');
            if infotbl[cap_ptr+8] and 2=2 then writeln('     Non-Fatal Error Reporting Enabled');
            if infotbl[cap_ptr+8] and 4=4 then writeln('     Fatal Error Reporting Enabled');
            if infotbl[cap_ptr+8] and 8=8 then writeln('     Unsupported Request Reporting Enabled');
            write('     Unsupported Request Severity is ');
            if infotbl[cap_ptr+8] and 16=16 then writeln('Fatal') else writeln('Non-Fatal');


{ **** Device Status field 0ah-0bh}
            if infotbl[cap_ptr+$a] and 1=1 then writeln('     Correctable Error Detected');
            if infotbl[cap_ptr+$a] and 2=2 then writeln('     Non-Fatal Error Detected');
            if infotbl[cap_ptr+$a] and 4=4 then writeln('     Fatal Error Detected');
            if infotbl[cap_ptr+$a] and 8=8 then writeln('     Unsupported Request Detected');
            if infotbl[cap_ptr+$a] and 16=16 then writeln('     AUX Power Detected');
            if infotbl[cap_ptr+$a] and 32=32 then writeln('     Device Reports Transactions Pending');


{ **** Link Capabilities field 0ch-0fh}
          write('     Maximum Link speed : ');
          case infotbl[cap_ptr+$c] and $f of
            1 : writeln('2.5Gb/s');
            else writeln('Unknown (',wrhex(infotbl[cap_ptr+$c] and $f),'h)!!');
          end;

          write('     Maximum Link Width : x');
          lw:=((infotbl[cap_ptr+$d] and 3) shl 4) + ((infotbl[cap_ptr+$c] and $f0) shr 4);
          if lw=0 then writeln('Reserved') else writeln(lw);

          writeln('     Link Port Number   : ',infotbl[cap_ptr+$f]);

{ **** Link Control 10h-11h }

            if infotbl[cap_ptr+$10] and 4=4 then writeln('     Link is in Loopback mode');
            if infotbl[cap_ptr+$10] and 16=16 then writeln('     Link is Disabled');
          if infotbl[cap_ptr+$10] and 64=64 then writeln('     Common Clock Configuration In Use')
        else writeln('Asynchronous Clocking in Use');


{ **** Link Status 12h-13h }
              write('     Current Link speed : ');
          case infotbl[cap_ptr+$12] and $f of
            1 : writeln('2.5Gb/s');
            else writeln('Unknown (',wrhex(infotbl[cap_ptr+$c] and $f),')!!');
          end;

          write('     Current Link Width : x');
          lw:=((infotbl[cap_ptr+$13] and 3) shl 4) + ((infotbl[cap_ptr+$12] and $f0) shr 4);
          if infotbl[cap_ptr+$13] and 8=8 then writeln('??') else writeln(lw);
          if infotbl[cap_ptr+$13] and 4=4 then writeln('     Link Training Error Reported!!');
          if infotbl[cap_ptr+$13] and 8=8 then writeln('     Link Training Currently In Progress!!');

{ **** Slot Capabilities 14h-17h, slots & root ports only }
           if (infotbl[cap_ptr+2] shr 4)>1 then
           begin
             if infotbl[cap_ptr+$14] and 1=1 then writeln('     Attention Button Present');
             if infotbl[cap_ptr+$14] and 2=2 then writeln('     Power Controller Present');
             if infotbl[cap_ptr+$14] and 4=4 then writeln('     MRL Sensor Present');
             if infotbl[cap_ptr+$14] and 8=8 then writeln('     Attention Indicator Present');
             if infotbl[cap_ptr+$14] and 16=16 then writeln('     Power Indicator Present');
             if infotbl[cap_ptr+$14] and 32=32 then writeln('     Hot Plug Surprise is Possible');
             if infotbl[cap_ptr+$14] and 64=64 then writeln('     Hot Plug Capable');

             writeln('     Physical slot Number ',(word(word(infotbl[cap_ptr+$17]) shl 2)+(infotbl[cap_ptr+$16] shr 6)));
         end;
       end;



     $11 : begin
         writeln('   MSI-X Capability');
       end;


      else writeln('   Unknown Capability (Code ',wrhex(infotbl[cap_ptr]),'h)!!');
    end;
  cap_ptr:=infotbl[cap_ptr+1];
  until cap_ptr=0 else writeln('  No ''New Capabilities'' Are Currently Enabled!');
end;




procedure showallinfo;
var
  j,
  i     : integer;
  pp,
  nn,
  x    : byte;
  gotit    : boolean;

begin
    if businfo then
    begin
      write(' Bus ');
      textcolor(11);
      write(bus);
      textcolor(7);
      write(' (');

{ look for CardBus }
      gotit:=false;
      if cardptr>0 then
      begin
        for x:=1 to cardptr do if bus=cardbus[x] then
        begin
          write('Cardbus');
          gotit:=true;
        end;
      end;


{ look for PCI Express }
{type 0}  if infotbl[$e] and $7f=0 then cap_ptr:=infotbl[$34];
{type 1}  if infotbl[$e] and $7f=1 then cap_ptr:=infotbl[$34];
{type 2}  if infotbl[$e] and $7f=2 then cap_ptr:=infotbl[$14];
      if cap_ptr<>0 then
          repeat
            if infotbl[cap_ptr]=$10 then
            begin
              write('PCI Express');
              gotit:=true;
            end;
            cap_ptr:=infotbl[cap_ptr+1];
          until cap_ptr=0;


{ we crudely assume bus x is AGP if it's got the VGA Mapping flag set on it's parent PCI bridge - this is probably
  not prefect, but will do for now!!

  It's wrong because on a board with an AGP slot but no AGP card inserted, VGA Mapping will be off. This could also
  be the case if the AGP card isn't the primary adapter (eg a PCI one is). This is more accurate than previous
  attempts, however, as it avoids the situation where a board with bridges but without AGP is falsely reported.

  Previously, we could get false positives (very bad); now we get false negitives (not so bad, but still not perfect) }



{ try to guess AGP bus number by looking for a set VGA Mapping flag on a PCI-PCI Bridge. This works because the host
  bridge will always appear before it's own child busses... ie this 'detects' the bus, the next block actually reports
  the results in a later iteration (when the right bus number is finally reached) }

      if infotbl[$e] and $7f=1 then if infotbl[$3e] and 8=8 then agpbusnum:=infotbl[$19];

{ assume plain old PCI if nothing else matches }
      if not gotit then if bus=agpbusnum then write('AGP') else write('PCI');
      write('), Device Number ');
          textcolor(11);
      write(deviceid);
          textcolor(7);
      write(', Device Function ');
          textcolor(11);
      writeln(func);
          textcolor(7);
    end;


      if installermode then showinstallerinfo else
      begin




      write(' Vendor ',wrhexw(infotbl[1] shl 8+infotbl[0]),'h ');
      cmpstr:=wrhexw(infotbl[1] shl 8+infotbl[0]);
      lookupven(false);
      writeln;


      write(' Device ',wrhexw(infotbl[3] shl 8+infotbl[2]),'h ');
      cmpstr:=wrhexw(infotbl[3] shl 8+infotbl[2]);
      lookupdev;
      writeln;


      if not summary then
      begin
        write(' Command ',wrhexw(infotbl[5] shl 8+infotbl[4]),'h');
        first:=true;
        write(' (');
        if infotbl[4] and 1=1 then printstatus('I/O Access');
        if infotbl[4] and 2=2 then printstatus('Memory Access');
        if infotbl[4] and 3=0 then printstatus('Bus Access Disabled!!');
        if infotbl[4] and 4=4 then printstatus('BusMaster');
        if infotbl[4] and 8=8 then printstatus('Special Cycles');
        if infotbl[4] and 16=16 then printstatus('MemWrite+Invalidate');
        if infotbl[4] and 32=32 then printstatus('VGA Palette Snoop');
        if infotbl[4] and 64=64 then printstatus('Parity Error Response');
        if infotbl[4] and 128=128 then printstatus('Wait Cycles');
        if infotbl[5] and 1=1 then printstatus('System Errors');
        if infotbl[5] and 2=2 then printstatus('Back-To-Back Transactions');
        if infotbl[5] and 4=4 then printstatus('Interrupt Disable');
        writeln(')');


        write(' Status ',wrhexw(infotbl[7] shl 8+infotbl[6]),'h');
        if (infotbl[6]<>0) or (infotbl[7]<>0) then
        begin
          first:=true;
          write(' (');
          if infotbl[6] and 8=8 then printstatus('Signalled Interrupt');
          if infotbl[6] and 16=16 then printstatus('Has Capabilities List');
          if infotbl[6] and 32=32 then printstatus('Supports 66MHz');
          if infotbl[6] and 64=64 then printstatus('Has UDF');
          if infotbl[6] and 128=128 then printstatus('Supports Back-To-Back Trans.');

          if infotbl[7] and 1=1 then printstatus('Data parity Error Detected');
          if infotbl[7] and 8=8 then printstatus('Signalled Target Abort');
          if infotbl[7] and 16=16 then printstatus('Received Target Abort');
          if infotbl[7] and 32=32 then printstatus('Received Master Abort');
          if infotbl[7] and 64=64 then printstatus('Signalled System Error');
          if infotbl[7] and 128=128 then printstatus('Detected Parity Error');

          case ((infotbl[7] and 6) shr 1) of
        0 : printstatus('Fast Timing');
        1 : printstatus('Medium Timing');
        2 : printstatus('Slow Timing');
        3 : printstatus('Unknown Timing');
          end;
          write(')');

        end;
        writeln;

        write(' Revision ',wrhex(infotbl[8]),'h');
        write(', Header Type ',wrhex(infotbl[$e]),'h');
        writeln(', Bus Latency Timer ',wrhex(infotbl[$d]),'h');

{ header type 0 only : display latency and grant figures }
       if infotbl[$e] and $7f=0 then
       begin
         if (infotbl[$3e]<>0) or (infotbl[$3f]<>0) then
           writeln(' Minimum Bus Grant ',wrhex(infotbl[$3e]),'h, Maximum Bus Latency ',wrhex(infotbl[$3f]),'h');
       end;

{ self test }
        write(' Self test ',wrhex(infotbl[$f]),'h (Self test ');
        if infotbl[$f] and $80=0 then write('not ');
        write('supported');


        if infotbl[$f] and $80=$80 then
        begin
          write(': Completion code ',wrhexb(infotbl[$f] and $f),'h - ');
          if infotbl[$f] and $f=0 then
          begin
        textcolor(10);
        write('OK');
        textcolor(7);
          end else
          begin
        textcolor(12);
        write('Failed!!');
        textcolor(7);
          end;
        end;

        writeln(')');


        if infotbl[$c]<>0 then writeln(' Cache line size ',infotbl[$c]*4,' Bytes (',infotbl[$c],' DWords)');

{ class code stuff }

        write(' PCI Class ');

        if infotbl[$b]=$ff then
        begin
          write('FFh ');
          textcolor(10);
          write('(does not meet any PCI-SIG defined class)');
          textcolor(7);
        end else
        begin

        found:=false;


        for i:=0 to high_class_name do
        if infotbl[$b]=i then
          begin
          textcolor(14);
          write(PCI_class_names[i]);
          textcolor(7);
          found:=true;
        end;

        if not found then
        begin
          textcolor(12);
          write('Unknown! ');
          textcolor(7);
          write('(Class ',wrhex(infotbl[$b]),'h)')
        end;

        write(', type ');


        found:=false;

        for i:=0 to high_class_array do
         begin
          if (pci_class_array[i].class=infotbl[$b]) and
          (pci_class_array[i].subclass=infotbl[$a]) and
          (pci_class_array[i].progif=infotbl[$9]) then
          begin
        found:=true;
        textcolor(14);
        write(PCI_class_array[i].name);
        textcolor(7);
          end;
        end;


        if not found then
        begin
          for i:=0 to high_class_array do
          begin
        if (pci_class_array[i].class=infotbl[$b]) and
        (pci_class_array[i].subclass=infotbl[$a]) then
        begin
          found:=true;
          textcolor(14);
          write(PCI_class_array[i].name);
          textcolor(7);
        end;
          end;
        end;


        if not found then
        begin
          textcolor(12);
          write('Unknown!');
          textcolor(7);
               write(' (Subclass ',wrhex(infotbl[$a]),'h, ProgIF ',wrhex(infotbl[9]),'h)');
        end;
        end;
        writeln;
      end;






      if not summary then
      begin
{ look for generic PCI IDE controller & decode it's info, if present }
       if (infotbl[$b]=01) and (infotbl[$a]=01) then
       begin
         writeln(' PCI EIDE Controller Features :');
         write('   BusMaster EIDE is ');
         if infotbl[$9] and $80=0 then
         begin
           textcolor(12);
           write('NOT ');
           textcolor(7);
         end;
         writeln('supported');

         write('   Primary   Channel is ');
         if infotbl[$9] and 1=0 then
         begin
           writeln('at I/O Port 01F0h and IRQ 14');
           if infotbl[$3c]<>14 then inc(irqmap[14]);
         end else writeln('in native mode at Addresses 0 & 1');
         write('   Secondary Channel is ');
         if infotbl[$9] and 4=0 then
         begin
           writeln('at I/O Port 0170h and IRQ 15');
           if infotbl[$3c]<>15 then inc(irqmap[15]);
         end else writeln('in native mode at Addresses 2 & 3');
       end;

       end else
       begin
{ summary mode: pick up IRQs only }
         if (infotbl[$b]=01) and (infotbl[$a]=01) then
         begin
           if (infotbl[$9] and 1=0) and (infotbl[$3c]<>14) then inc(irqmap[14]);
           if (infotbl[$9] and 4=0) and (infotbl[$3c]<>15) then inc(irqmap[15]);
         end;
       end;




{ if type 0 table & if Subsystem ID exists, display and scan file for match }
       if infotbl[$e] and $7f=0 then
       if (infotbl[$2c]<>0) or (infotbl[$2d]<>0) or (infotbl[$2e]<>0) or (infotbl[$2f]<>0) then
       begin

{ subsystem ID }


         write(' Subsystem ID ',wrhexw(infotbl[$2f] shl 8+infotbl[$2e]));
         write(wrhexw(infotbl[$2d] shl 8+infotbl[$2c]),'h');
         cmpstr:=wrhexw(infotbl[$2f] shl 8+infotbl[$2e])+wrhexw(infotbl[$2d] shl 8+infotbl[$2c]);


         genssid:=false;
         if (infotbl[$2c]=infotbl[0])
         and (infotbl[$2d]=infotbl[1])
         and (infotbl[$2e]=infotbl[2])
         and (infotbl[$2f]=infotbl[3]) then genssid:=true;

         oemidnum:='';
         oemidstr:='';
         bogusid:=false;
         failed:=true;
{ use the line that was read for revchk, or the first O or X entry will be missed! }
         userev:=true;


         if not eof(f) then
         begin
           repeat
         if userev and (revchk<>'') then vstr:=revchk else readln(f,vstr);
         userev:=false;

{ OEM Vendor ID }
         if vstr[1]='O' then
         begin
           if copy(vstr,3,4)=copy(cmpstr,5,4) then
           begin
             oemidstr:=copy(vstr,8,length(vstr)); { closest match }
             oemidnum:=copy(vstr,3,4); { matching vendor name }
           end;
         end;


         if vstr[1]='S' then
         begin
           if copy(vstr,3,4)=copy(cmpstr,1,4) then
           begin
             if oemidnum<>'' then
             begin
               oemidstr:=copy(vstr,8,length(vstr));
               begin
             textcolor(14);
             write(' ',oemidstr);
             if genssid then
             begin
               textcolor(11);
               writeln(' (Generic ID)')
             end else writeln;
             failed:=false;
             textcolor(7);
               end;
             end;
           end;
         end;







{ Oddball 8 digit entry }
         if (vstr[1]='X') and (copy(vstr,3,8)=cmpstr) then
         begin
           oemidnum:=copy(vstr,7,4); { matching vendor name }
           bogusid:=true;
           textcolor(14);
           write(' ',copy(vstr,12,length(vstr)));
           if genssid then
           begin
             textcolor(11);
             writeln(' (Generic ID)')
           end else writeln;
           failed:=false;
           textcolor(7);
         end;


{ remember to ignore comment lines here also!!! }

           until eof(f) or not failed or ((vstr[1]<>'O') and (vstr[1]<>'X') and (vstr[1]<>'S') and(vstr[1]<>';'));
         end;






         if failed then
         begin
           if oemidstr<>'' then
           begin
         textcolor(14);
         write(' ',oemidstr);
         textcolor(15);
         write(' (Guess Only!)');
         textcolor(7);
           end else
           begin
         textcolor(12);
         write(' Unknown');
           end;

           if genssid then
           begin
         textcolor(11);
         writeln(' (Generic ID)')
           end else writeln;
           textcolor(7);
         end;


{ subsystem vendor }
         write(' Subsystem Vendor ',wrhexw(infotbl[$2d] shl 8+infotbl[$2c]),'h');

         if bogusid then
         begin
           textcolor(15);
           writeln(' Known Bad Subsystem ID - no Vendor ID Available');
           textcolor(7);
         end else
         begin
           if oemidnum<>'' then cmpstr:=oemidnum
           else cmpstr:=wrhexw(infotbl[$2d] shl 8+infotbl[$2c]);
           close(f);        { get back to start of file, as the}
           reset(f);        { subsys vendor may be higher up...!}
           failed:=true;
           if not eof(f) then
           begin
         repeat
           readln(f,vstr);
                   if length(vstr)<3 then vstr:=';   oops';
           if (vstr[1]='V') and (copy(vstr,3,4)=cmpstr) then
           begin
             textcolor(14);
             writeln(' ',copy(vstr,8,length(vstr)));
             failed:=false;
             textcolor(7);
           end;
         until eof(f) or not failed;
           end;
           if failed then
           begin
         textcolor(12);
         writeln(' Unknown');
         textcolor(7);
           end;
         end;
       end;
{ always }
       close(f);




{ Memory & I/O  registers }
       if not summary then
       begin
{ type 0 header = 6 entries, type 1 = 2, type 2 = skip }
       pp:=0;
       if infotbl[$e] and $7f=0 then pp:=5;
       if infotbl[$e] and $7f=1 then pp:=1;

       if pp>0 then for nn:=0 to pp do
       begin
         if infotbl[$10+(nn*4)]+infotbl[$11+(nn*4)]+
           infotbl[$12+(nn*4)]+infotbl[$13+(nn*4)]<>0 then
         begin
           write(' Address ',nn,' is a');
           if infotbl[$10+(nn*4)] and 1=1 then
           begin
         write('n I/O Port : ');
         addr:=infotbl[$13+(nn*4)] shl 8 + infotbl[$12+(nn*4)];
         write(wrhexw(addr));
         addr:=infotbl[$11+(nn*4)] shl 8 + (infotbl[$10+(nn*4)] and $fc);
         write(wrhexw(addr),'h');
           end else
           begin
         write(' Memory Address');
         if infotbl[$10+(nn*4)] and 6=0 then write(' (anywhere in 0-4Gb');
         if infotbl[$10+(nn*4)] and 6=2 then write(' (below 1Mb');
         if infotbl[$10+(nn*4)] and 6=4 then write(' (anywhere in 64-bit space');
         if infotbl[$10+(nn*4)] and 6=6 then write(' (reserved');
         if infotbl[$10+(nn*4)] and 8=8 then write(', Prefetchable) : ') else write(') : ');
         addr:=infotbl[$13+(nn*4)] shl 8 + infotbl[$12+(nn*4)];
         write(wrhexw(addr));
         addr:=infotbl[$11+(nn*4)] shl 8 + (infotbl[$10+(nn*4)] and $f0);
         write(wrhexw(addr)+'h');
           end;

{ size the register ?? }

           writeln;
         end;
       end;


       end;


{ all header types - list IRQ, if present }
       if (infotbl[$3c]<16) and (infotbl[$3c]>0) then
       begin
         write(' System IRQ ',infotbl[$3c],', INT# ');
         if infotbl[$3d]=0 then write('-') else write(chr(infotbl[$3d]+64));
         writeln;
         inc(irqmap[infotbl[$3c]]);
       end;




{ type 0,1 header only - List ExpROM, if present }
       if not summary then
       begin
       if (infotbl[$e] and $7f=0) or (infotbl[$e] and $7f=1) then
       begin
         if infotbl[$e] and $7f=0 then lb:=$30;
         if infotbl[$e] and $7f=1 then lb:=$38;

{ backup original value }
               rom_backup:=infotbl[lb+3] shl 24 + infotbl[lb+2] shl 16 + infotbl[lb+1] shl 8 + infotbl[lb];
{ perform test write }
         if usebios then write_dword_bios(deviceid,func,bus,lb,$ffff,$fffe) else write_dword_hw(deviceid,func,bus,lb,$ffff,$fffe);
         for i:=lb to lb+3 do if usebios then infotbl[i]:=lookup_bios(deviceid,func,bus,i)
           else infotbl[i]:=lookup_hw(deviceid,func,bus,i);
{ restore original value regardless }
           if usebios then write_dword_bios(deviceid,func,bus,lb,rom_backup shr 16,rom_backup and $ffff)
         else write_dword_hw(deviceid,func,bus,lb,rom_backup shr 16,rom_backup and $ffff);
{ if any bit in 31..11 = 1, we have expROM }
           if (infotbl[lb+3]<>0) or (infotbl[lb+2]<>0) or ((infotbl[lb+1] and $f8)<>0) then
           begin
{ find lowest 1-bit, gives expROM size }
         romsize:=1;
             romresult:=infotbl[lb+3] shl 24 + infotbl[lb+2] shl 16 + ((infotbl[lb+1] and $f8) shl 8);
         found:=false;
         repeat
           if romresult and romsize=romsize then found:=true else romsize:=romsize shl 1;
         until found or (romsize=0);
         romsize:=romsize shr 10;
         write(' Expansion ROM of ');
             if romsize>1023 then write(romsize shr 10,'Mb') else write(romsize,'Kb');
             write(' decoded by this card (Currently ');
             if rom_backup and 1=1 then writeln('enabled)') else writeln('disabled)');
           end;
{ restore infotbl[] to original values }
           infotbl[lb]:=rom_backup and $ff;
           infotbl[lb+1]:=(rom_backup shr 8) and $ff;
           infotbl[lb+2]:=(rom_backup shr 16) and $ff;
           infotbl[lb+3]:=(rom_backup shr 24) and $ff;
         end;
       end;









{ PCI Bridges info starts here }

{ type 1 header only - List bridge info }

       if not summary then
       begin

       if infotbl[$e] and $7f=1 then
       begin
          writeln(' PCI Bridge Information:');
         write('   Primary Bus Number ',infotbl[$18],', Secondary Bus Number ',infotbl[$19]);
         writeln(', Subordinate Bus Number ',infotbl[$1a]);

{ seconday bus command }
         first:=true;
         write('   Secondary Bus Command ',wrhexw(infotbl[$3f] shl 8 + infotbl[$3e]),'h ');
         write('(');
         if infotbl[$3e] and 1=1 then printstatus('parity detection');
         if infotbl[$3e] and 4=4 then printstatus('ISA mapping');
         if infotbl[$3e] and 8=8 then printstatus('VGA mapping');
         if infotbl[$3e] and 32=32 then printstatus('master abort mode');
         if infotbl[$3e] and 64=64 then printstatus('secondary bus is in RESET');
         if infotbl[$3e] and 128=128 then printstatus('back-to-back transactions');
         writeln(')');


{ secondary bus status }
        write('   Secondary Bus Status ',wrhexw(infotbl[$1f] shl 8+infotbl[$1e]),'h');
        if (infotbl[$1e]<>0) or (infotbl[$1f]<>0) then
        begin
          first:=true;
          write(' (');
          if infotbl[$1e] and 32=32 then printstatus('Supports 66MHz');
          if infotbl[$1e] and 128=128 then printstatus('Supports Back-To-Back Trans.');
          if infotbl[$1f] and 1=1 then printstatus('Data parity Error Detected');
          if infotbl[$1f] and 8=8 then printstatus('Signalled Target Abort');
          if infotbl[$1f] and 16=16 then printstatus('Received Target Abort');
          if infotbl[$1f] and 32=32 then printstatus('Received Master Abort');
          if infotbl[$1f] and 64=64 then printstatus('Received System Error');
          if infotbl[$1f] and 128=128 then printstatus('Detected Parity Error');
          case ((infotbl[$1f] and 6) shr 1) of
        0 : printstatus('Fast Timing');
        1 : printstatus('Medium Timing');
        2 : printstatus('Slow Timing');
        3 : printstatus('Unknown Timing');
          end;
          write(')');
        end;
        writeln;

{ latency }
        writeln('   Secondary Bus Latency ',wrhex(infotbl[$1b]),'h');

{ I/O port range passed by bridge }
         if (infotbl[$1c]<>0) or (infotbl[$1d]<>0) then
         begin
           write('   I/O Port Range Passed to Secondary Bus : ');

{ 16-bit I/O }
           if infotbl[$1c] and $f=0 then
           begin
         if infotbl[$1d]<infotbl[$1c] then writeln('None') else
         begin
           write(wrhexb(infotbl[$1c] shr 4),'000h to ');
           writeln(wrhexb(infotbl[$1d] shr 4),'FFFh (16-bit)');
         end;
           end;
{ 32-bit I/O }
           if infotbl[$1c] and $f=1 then
           begin
         if (infotbl[$33] shl 8 + infotbl[$32]) < (infotbl[$31] shl 8 + infotbl[$30]) then writeln('None') else
         begin
           write(wrhexw(infotbl[$31] shl 8 + infotbl[$30]),wrhexb(infotbl[$1c] shr 4),'000h to ');
           writeln(wrhexw(infotbl[$33] shl 8 + infotbl[$32]),wrhexb(infotbl[$1d] shr 4),'FFFh (32-bit)');
         end;
           end;
         end;



{ memory range passed by bridge }
         write('   Memory   Range Passed to Secondary Bus : ');
         mb:=((infotbl[$21] shl 8) + infotbl[$20]) and $fff0;
         ml:=((infotbl[$23] shl 8) + infotbl[$22]) or $000f;
         if ml<mb then writeln('None') else writeln(wrhexw(mb),'0000h to ',wrhexw(ml),'FFFFh');


{ optional: prefectchable memory range passed by bridge }
         if ((infotbl[$27] shl 8 + infotbl[$26])<>0) or ((infotbl[$25] shl 8 + infotbl[$24])<>0) then
         begin
           write('   Prefectchable Memory Range Passed to Secondary Bus : ');
           mb:=((infotbl[$25] shl 8) + infotbl[$24]) and $fff0;
           ml:=((infotbl[$27] shl 8) + infotbl[$26]) or $000f;
               if ml<mb then writeln('None') else
               begin
{ 64 bit base reg? }
         if infotbl[$24] and $0f=1 then
           write(wrhexw(infotbl[$2b] shl 8 + infotbl[$2a]),wrhexw(infotbl[$29] shl 8 + infotbl[$28]));
             write(wrhexw(mb),'0000h to ');
{ 64 bits limit reg? }
         if infotbl[$26] and $0f=1 then
           write(wrhexw(infotbl[$2f] shl 8 + infotbl[$2e]),wrhexw(infotbl[$2d] shl 8 + infotbl[$2c]));
             writeln(wrhexw(ml),'FFFFh');
           end;
         end;


       end;
       end;





{ type 2 header only - List bus numbers etc }

       if not summary then
       begin
         if infotbl[$e] and $7f=2 then
         begin
           write(' PCI bus number ',infotbl[$18],', CardBus bus number ',infotbl[$19]);
           writeln(', Subordinate bus number ',infotbl[$1a]);
           writeln(' CardBus latency ',wrhex(infotbl[$1b]),'h');
         end;
       end;


{ explore the capabilities list, if present }
       if not summary then
       begin
         if (infotbl[6] and $10=$10) then docapdecode;
       end;


{ do a hex-dump, if requested }
       if dumpregs then
       begin
         writeln;
         writeln(' Hex-Dump of device configuration space follows:');
         write('  0000  ');
         for i:=0 to $ff do
         begin
           if (i>0) and (i mod 16=0) then
           begin
         write('   ');
         for j:=i-16 to i-1 do if ord(infotbl[j])<32 then write('.') else write(chr(infotbl[j]));
         writeln;
         write('  ',wrhexw(i),'  ');
           end;
           write(wrhex(infotbl[i]),' ');
         end;
         write('   ');
         for j:=240 to 255 do if ord(infotbl[j])<32 then write('.') else write(chr(infotbl[j]));
         writeln;
       end;

    writeln;
  end;
end;
















begin
  agpbusnum:=$ff;
  businfo:=false;
  dorouting:=true;
  dopcirouting:=false;
  dumpregs:=false;
  usebios:=true;
  summary:=false;
  installermode:=false;
  cardptr:=0;

{ the following hack permits MS-DOS display output redirection to work }
  if ioredirected then
  begin
    writeln('Craig Hart''s PCI+AGP bus sniffer, version ',revision,', freeware made in 1996-2001.');
    assign(output,'');
    rewrite(output);
  end else
{ code to do page pausing }
  begin
    ClrScr;
    linecounter:=0;
    with TextRec(Output) do
    begin
      org_output:=FlushFunc;
      FlushFunc:=@page_output_FlushFunc;
    end;
  end;



  for i:=0 to 15 do irqmap[i]:=0;
  failed:=true;




  if paramcount>0 then
  begin
    for i:=1 to paramcount do
    begin
      cmdstr:=paramstr(i);
      for j:=1 to length(cmdstr) do cmdstr[j]:=upcase(cmdstr[j]);
      if (cmdstr='/R') or (cmdstr='-R') then showtree:=true;
      if (cmdstr='/H') or (cmdstr='-H') then usebios:=false;
      if (cmdstr='/D') or (cmdstr='-D') then dumpregs:=true;
      if (cmdstr='/T') or (cmdstr='-T') then dorouting:=false;
      if (cmdstr='/P') or (cmdstr='-P') then dopcirouting:=true;
      if (cmdstr='/B') or (cmdstr='-B') then businfo:=true;
      if (cmdstr='/S') or (cmdstr='-S') then summary:=true;
      if (cmdstr='/I') or (cmdstr='-I') then installermode:=true;
      if (cmdstr='?') or (cmdstr='/?') or (cmdstr='-?') then
      begin
    textmode(co80);
    writeln(' Help for PCI  (Version ',revision,')');
    textcolor(8);
    writeln('───────────────────────────────');
    textcolor(7);
    writeln;
    writeln('Usage: PCI [-H][-D][-S][-T][-B][-P][-R][-?]    [ ] indicates optional parameter');
    writeln;
    writeln('-H : Use direct hardware access (instead of the BIOS) to retrieve PCI Info');
    writeln('     May be required for accurate reporting on Intel 430FX chipset+Award BIOS');
    writeln('-D : Do a hex-dump of each device''s entire configuration space');
    writeln('-S : Create a brief, summary report only; only devices and IRQs listed');
    writeln('-T : Disable the test ROM IRQ Routing Table function');
    writeln('-B : Enable display of the Bus, Device & Function information');
    writeln('-P : Enable display of PCI slot routing data');
    writeln('-I : Installer mode: produce raw data dump (for use with auto-setup programs)');
    writeln('-R : Draw a Tree of Busses, Devices and Device Functions');
    writeln('-? : Displays this help screen!');
    writeln;
    writeln('PCI Supports generating reports to a file or printer using MS-DOS pipes; i.e.');
    writeln;
    writeln('  PCI -D > REPORT.TXT  (Save report to file),  PCI > LPT1:  (Print report)');
    writeln;
    writeln('PCI is written by Craig Hart, and is released as freeware, with no restictions');
    write('on use or copying. Visit ');
    textcolor(11);
    write('http://members.datafast.net.au/dft0802 ');
    textcolor(7);
    writeln('for updates to');
    writeln('the program and the PCI Database file PCIDEVS.TXT');
    halt(10);
      end;
    end;
  end;


{ fix up conflicting commandline switches }

  if installermode then
  begin
    dorouting:=false;
    dopcirouting:=false;
    dumpregs:=false;
    businfo:=false;
    summary:=false;
  end;

  if summary then
  begin
    dumpregs:=false;
    dopcirouting:=false;
    dorouting:=false;
  end;




  if not installermode then
  begin
    assign(f,'pcidevs.txt');
    {$i-}
    reset(f);
    if ioresult<>0 then
    begin
      writeln('PCI Halted:');
      writeln;
      writeln('Sorry, I cannot locate my PCIDEVS.TXT datafile!!!');
      writeln('I expect it to be in the CURRENT directory, so don''t run me from a path!!!');
      halt(10);
    end;
    close(f);
    {$i+}
  end;



  if test8086<2 then
  begin
    writeln('PCI Halted:');
    writeln;
    writeln('The PC Must be at least a 386 to possibly have a PCI or AGP bus!');
    halt(1);
  end;

{ Look for PCI BIOS }

  asm
    mov ax,$b101
    int $1a
    jc @exit

{ check signature bytes OK }
    cmp dx,$4350
    jne @exit

{ check no error code returned > AH=00=Success }
    cmp ah,0
    jne @exit

    mov PCIchar,al
    mov PCI_hibus,cl
    mov PCIverlo,bl
    mov PCIverhi,bh
    mov failed,false

  @exit:
  end;

  if failed then
  begin
    writeln('PCI Halted:');
    writeln;
    writeln('No PCI BIOS was detected! (NB: I don''t work under Windows NT/2000/XP/2003 etc!)');
    writeln;
    writeln('For PCI reports under Win NT-era OS''s such as NT/2K/XP/2K3, use PCI32.EXE');
    writeln('which is available from the same website as this program (See PCI /? for the');
    writeln('website address.)');
    writeln;
    halt(2);
  end;



{ OK, we have PCI... do our stuff.. }


  begin
    if not installermode then
    begin

      if not ioredirected then textmode(co80+font8x8);
      writeln(' Craig Hart''s PCI+AGP bus sniffer, version ',revision,', freeware made in 1996-2005.');
      writeln;
      write('PCI BIOS Version ',PCIverhi,'.',wrhex(PCIverlo),' found!');

      if summary then writeln('                                  (Summary Report)') else

      writeln;
      writeln('Number of PCI Busses : ',PCI_hibus+1);
      write('PCI Characteristics  : ');
      if PCIchar and 1=1 then write('Config Mechanism 1 ') else usebios:=true; { must use BIOS if no cfg mech 1 supported }
      if PCIchar and 2=2 then write('Config Mechanism 2 ');
      if PCIchar and 16=16 then write('Special Cycle Mechanism 1 ');
      if PCIchar and 32=32 then write('Special Cycle Mechanism 2 ');
      writeln;
      writeln;
      write('Searching for PCI Devices using ');
      if usebios then writeln('the System BIOS') else writeln('Configuration Mechanism 1');
      writeln;
    end;




    for bus:=0 to pci_hibus do        { fix bugs for 440LX chipset, 2 PCI buses, AGP=1 bus! }
    begin
      for deviceid:=0 to $1f do
      begin
        func:=0;
        repeat
      index:=0;
      repeat
        if usebios then info:=lookup_bios(deviceid,func,bus,index) else info:=lookup_hw(deviceid,func,bus,index);
        infotbl[index]:=info;
        inc(index);
{don't try to read cfg-space of non-existant devices: hangs some chipsets!}
        if index=2 then if (infotbl[0]=$ff) and (infotbl[1]=$ff) then index:=$100;
{don't read past $3f if in short-info modes; avoids crashing on intolerant hardware!}
        if index=$40 then if installermode or summary then index:=$100;
      until (index=$100);
      if (infotbl[0]<>$ff) or (infotbl[1]<>$ff) then
      begin
{ remember CardBus stuff for later; skip if far bus=0 (i.e. unconfigured) }
        if (infotbl[$e] and $7f=2) and (infotbl[$19]<>0) then
        begin
          cardbus[cardptr+1]:=infotbl[$19];
          cardptr:=cardptr+1;
        end;
        showallinfo;
      end;
      inc(func);
{ if func 0 = invalid device, don't test for presence of func 1->7 at all. [$e] isn't valid if [0] and [1] aren't!! }
          if (func=1) and (infotbl[0]=$ff) and (infotbl[1]=$ff) then func:=8;
{ If not multi-device device, then don't test for func 1-7 as some cards
incorrectly answer back on all 8 function numbers!!! S3 trio64, for example - stupid!  }
          if (func=1) and (infotbl[$e] and $80=0) then func:=8;
        until func=8; {func }
      end; {dev }
    end; { bus }



{ now scan any CardBus busses that weren't included in the BIOS bus count }



    if cardptr>0 then
    begin
      for cbu:=1 to cardptr do        { scan all cardbus busses }
      begin
    bus:=cardbus[cbu];
    if bus>pci_hibus then        { but only those the BIOS hasn't already had us scan }
    begin
      for deviceid:=0 to $1f do
      begin
        func:=0;
        repeat
          index:=0;
          repeat
                if usebios then info:=lookup_bios(deviceid,func,bus,index) else info:=lookup_hw(deviceid,func,bus,index);
        infotbl[index]:=info;
        inc(index);
        if index=2 then if (infotbl[0]=$ff) and (infotbl[1]=$ff) then index:=$100;
        if index=$40 then if installermode or summary then index:=$100;
          until (index=$100);
          if (infotbl[0]<>$ff) or (infotbl[1]<>$ff) then showallinfo;
          inc(func);
          if (func=1) and (infotbl[0]=$ff) and (infotbl[1]=$ff) then func:=8;
          if (func=1) and (infotbl[$e] and $80=0) then func:=8;
        until func=8;
      end;
    end;
      end;
    end;

{
  The following is an experiment with "Get IRQ Routing Info" BIOS function:
  the avid coder is free to un-comment the code and try it out: I couldn't
  make much sense out of the information returned myself!
}



    if dopcirouting then
    begin


      writeln;
      writeln('PCI slot IRQ mapping information');
      irqbuff[0]:=lo(1024);
      irqbuff[1]:=hi(1024);

      irqbuff[2]:=lo(ofs(irqbuff)+2);
      irqbuff[3]:=hi(ofs(irqbuff)+2);
      irqbuff[4]:=lo(seg(irqbuff));
      irqbuff[5]:=hi(seg(irqbuff));


      failed:=true;


      asm
    push ds

    mov bx,0
    mov ax,seg irqbuff
    mov es,ax
    mov di,offset irqbuff
    mov ax,0f000h
    mov ds,ax
    mov ax,0b10eh

    int $1a
    pop ds

    mov cx,word ptr es:[di]

    cmp ah,0
    jne @exit


    mov conmap,bx
    mov len,cx
    mov failed,false

      @exit:
      end;


      if not failed then
      begin
    textcolor(10);
    writeln(' PCI slot mapping information read successfully');
    textcolor(7);
    writeln;


{ hex-dump table }
    if dumpregs then dohexdump;

{}
    writeln(' PCI slot IRQ availability listing');
    writeln;
    for i:=0 to (len shr 4)-1 do
    begin
      writeln('  PCI Bus ',irqbuff[2+(i*16)],', Device ',irqbuff[3+(i*16)] shr 3,', Slot ',wrhex(irqbuff[16+(i*16)]));
      listmap(irqbuff[6+(i*16)] shl 8 + irqbuff[5+(i*16)],'   INTA# can be connected to IRQs ');
      listmap(irqbuff[9+(i*16)] shl 8 + irqbuff[8+(i*16)],'   INTB# can be connected to IRQs ');
      listmap(irqbuff[12+(i*16)] shl 8 + irqbuff[11+(i*16)],'   INTC# can be connected to IRQs ');
      listmap(irqbuff[15+(i*16)] shl 8 + irqbuff[14+(i*16)],'   INTD# can be connected to IRQs ');
      writeln;
    end;
    writeln;


{}
    writeln(' PCI slot INTx to IRQ-router mappings');
    writeln;
    writeln('  SLOT BUS DEV  INTA INTB INTC INTD');
    for i:=0 to (len shr 4)-1 do
    begin
      write('   ',wrhex(irqbuff[16+(i*16)]),'  ',irqbuff[2+(i*16)]:2,'  ',irqbuff[3+(i*16)] shr 3:2);
{      write('   ',irqbuff[3+(i*16)] and 3);}
      write('    ',wrhex(irqbuff[4+(i*16)]),'   ',wrhex(irqbuff[7+(i*16)]),'   ',
        wrhex(irqbuff[10+(i*16)]),'   ',wrhex(irqbuff[13+(i*16)]),'  ');

      if usebios then
      begin
        infotbl[0]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],0);
        infotbl[1]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],1);
        infotbl[2]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],2);
        infotbl[3]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],3);
        infotbl[4]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],4);
        infotbl[5]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],5);
        infotbl[6]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],6);
        infotbl[7]:=lookup_bios(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],7);
      end else
      begin
        infotbl[0]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],0);
        infotbl[1]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],1);
        infotbl[2]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],2);
        infotbl[3]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],3);
        infotbl[4]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],4);
        infotbl[5]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],5);
        infotbl[6]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],6);
        infotbl[7]:=lookup_hw(irqbuff[3+(i*16)] shr 3,irqbuff[3+(i*16)] and 3,irqbuff[2+(i*16)],7);
      end;

      cmpstr:=wrhexw(infotbl[1] shl 8+infotbl[0]);
      if cmpstr<>'FFFF' then
      begin
        lookupven(true);
        cmpstr:=wrhexw(infotbl[3] shl 8+infotbl[2]);
        lookupdev;
      end else write('No Device Detected');




      writeln;
    end;
    writeln;


{}
    listmap(conmap,' IRQ''s dedicated to PCI : ');

      end else
      begin
    textcolor(12);
    writeln(' Unable to read slot mapping information from PCI BIOS!');
    textcolor(7);
      end;
      writeln;
    end;





{ BIOS IRQ Routing table tests }

    if dorouting then
    begin
      showroutinginfo;
    end;





{ summarial IRQ info }

    if not installermode then
    begin
      writeln;
      write('IRQ Summary: ');
      failed:=true;
      disp:=0;
      for i:=0 to 15 do if irqmap[i]>0 then inc(disp); { count IRQs}
      for i:=0 to 15 do if irqmap[i]>0 then
      begin
    if failed then
    begin
      if disp=1 then write('IRQ ') else write('IRQs ');
    end else write(',');
    write(i);
    failed:=false;
      end;
      if failed then writeln('No IRQ''s are used by PCI Devices!') else
      begin
    if disp=1 then write(' is') else write(' are');
    writeln(' used by PCI devices');
      end;

      write('Shared IRQs: ');
      failed:=true;
      for i:=0 to 15 do if irqmap[i]>1 then
      begin
    if not failed then write('             ');
    writeln('IRQ ',i,' is shared by ',irqmap[i],' PCI Devices');
    failed:=false;
      end;
      if failed then writeln('There are no shared PCI IRQs');
    end;




{ walk the tree }

count:=0;

for bus:=0 to pci_hibus do
begin
  for deviceid:=0 to $1f do
  begin
    func:=0;
    repeat
      index:=0;
      repeat
        info:=lookup_hw(deviceid,func,bus,index);
    infotbl[index]:=info;
    inc(index);
{don't try to read cfg-space of non-existant devices: hangs some chipsets!}
    if index=2 then if (infotbl[0]=$ff) and (infotbl[1]=$ff) then index:=$40;
      until (index=$40); { index }

      if (infotbl[0]<>$ff) or (infotbl[1]<>$ff) then
      begin
{ we have a device ! }
        tree[count].b:=bus;
        tree[count].d:=deviceid;
        tree[count].f:=func;
        tree[count].vid:=infotbl[1] shl 8 + infotbl[0];
        tree[count].did:=infotbl[3] shl 8 + infotbl[2];
        inc(count);
      end;

      inc(func);
{ if func 0 = invalid device, don't test for presence of func 1->7 at all. [$e] isn't valid if [0] and [1] aren't!! }
      if (func=1) and (infotbl[0]=$ff) and (infotbl[1]=$ff) then func:=8;
{ If not multi-device device, then don't test for func 1-7 as some cards
incorrectly answer back on all 8 function numbers!!! S3 trio64, for example - stupid!  }
      if (func=1) and (infotbl[$e] and $80=0) then func:=8;
    until func=8; {func }
  end; {dev }
end; { bus }






if showtree and not installermode then
begin
  writeln;
  writeln;
  writeln('PCI Busses, Devices and Device Functions Tree');
  writeln;
  olb:=$ff;
  lastd:=tree[count-1].d;
  lastb:=tree[count-1].b;

  for i:=count to 199 do tree[i].d:=$ff;                                { flag unused }

  for i:=0 to count-1 do
  begin
    if tree[i].b<>olb then writeln('──Bus ',tree[i].b);                            { bus }
    if (tree[i].d=lastd) and (tree[i].b=lastb) and (tree[i].f=0) then write('   └──') else        { final tree item }
    if tree[i].f=0 then write('   ├──') else write('   │  ');                        { single F or MF dev }

{ up to here colums before "device" }
{ after here colums for func }

    if tree[i].f=0 then write(' Device ',wrhex(tree[i].d),'h');                        { device }

    if (tree[i].f=0) and (tree[i+1].d=tree[i].d) then
    begin
      writeln('');                                              { MF func 0 only }
      write('   │     ├── Function ',tree[i].f);
    end;
    if tree[i].f>0 then if tree[i+1].d=tree[i].d then
      write('   ├── Function ',tree[i].f) else write('   └── Function ',tree[i].f);        { func bar }
    write(' - ',wrhexw(tree[i].vid),'h:',wrhexw(tree[i].did),'h  ');
{
uncomment this to display the device names

    cmpstr:=wrhexw(tree[i].vid);
    lookupven(true);
    cmpstr:=wrhexw(tree[i].did);
    lookupdev;
}
    writeln;

    olb:=tree[i].b;
  end;
  writeln;
  writeln('A total of ',count-1,' Devices Found');
  writeln;
  writeln;
end;




  end;
end.